Shareware Grab Bag/Shareware Grab Bag.iso/011/lupc.bas

BASIC Source File | 1988-11-09 | 26.3 KB | 477 lines

100 REM ----------------------------------------------------------------------
110 REM | Copyright (c) 1983 - Scott Loftesness. All Rights Reserved.        |
120 REM | Program Name: LU --- A BASIC Library Manager                       |
130 REM | Author:       Scott Loftesness                                     |
140 REM |               20324 Highland Hall Drive                            |
150 REM |               Gaithersburg, MD 20879                               |
160 REM | Date:         4/16/83                                              |
170 REM | Purpose:                                                           |
180 REM |  To manage a library containing several files in a single file.    |
190 REM |  This program is based on the library format by G. Novosielski     |
195 REM |  modified by Scott Loftesness to add date and time information.    |
200 REM ----------------------------------------------------------------------
210 DEFINT A-Z:CLS:KEY OFF
215 TITLE$="PC/Library (Version 1.0 - 4/16/83)"
220 LOCATE 1,1:PRINT STRING$(79,&HC4);
230 LOCATE 24,1:PRINT STRING$(79,&HC4);
240 FOR I=1 TO 24:LOCATE I,1:PRINT CHR$(&HB3);
245 LOCATE I,79:PRINT CHR$(&HB3);:NEXT I
250 LOCATE 1,1:PRINT CHR$(&HDA);:LOCATE 1,79:PRINT CHR$(&HBF);:LOCATE 24,1:PRINT CHR$(&HC0);:LOCATE 24,79:PRINT CHR$(&HD9);
260 LOCATE 3,2:H1$="Library Utility (LU) for the IBM Personal Computer":GOSUB 990
270 LOCATE 4,2:H1$="Version 1.0 - (C) Copyright 1983 - Scott Loftesness":GOSUB 990
280 DIM I$(100),S$(10):S$(1)="Build New Library"
290 S$(2)="List Library Directory"
300 S$(3)="List Directory & Add Library Member"
310 S$(4)="List Directory & Get Library Member"
320 S$(5)="List Directory & List Library Member"
330 S$(6)="List Directory & Delete Library Member"
340 S$(7)="Spread Library to Individual Files"
345 S$(8)="Reorganize Existing Library"
347 S$(9)="Return to PC-DOS"
350 START=6
360 FOR I=1 TO 9
370 LOCATE START,20
380 PRINT S$(I);" ";STRING$(40-LEN(S$(I)),".");I;
390 START=START+2
400 NEXT I
410 LOCATE START+1,2
420 PRINT "Your Selection Please: ";:BEEP
430 LOCATE ,,1,0,11
440 I$=INKEY$:IF I$="" THEN 440
450 LOCATE ,,0:IF LEN(I$)>1 THEN BEEP:GOTO 440
460 IF (VAL(I$)>0) AND (VAL(I$)<10) THEN ON VAL(I$) GOTO 1000,4000,8000,3000,3000,7000,5000,995,6000
470 BEEP:LOCATE 25,40:PRINT SPC(25);:LOCATE 25,40:PRINT "ERROR- Invalid Selection!";:GOTO 410
500 REM ----------------------------------------------------------------------
510 REM | Subroutine to Get Filename Info from user.                         |
520 REM ----------------------------------------------------------------------
530 INPUT "Enter library name (w/o extension):",ARCHNAME$
540 IF ARCHNAME$="" THEN RETURN
550 IF INSTR(ARCHNAME$,".")<>0 THEN PRINT:PRINT "ERROR - Invalid file name specified - do not specify extension.":PRINT:GOTO 530
560 ARCHFIL$=ARCHNAME$+".lbr":ARCHDIR$=ARCHFIL$
570 RETURN
600 REM ----------------------------------------------------------------------
610 REM | Subroutine to Copy file into library (From #3 to #2)               |
620 REM ----------------------------------------------------------------------
630 FOR L!=0 TO LOF(3)-1 STEP 128
640 GET #3
650 FIELD 3, 128 AS INREC$
660 RECCNT=RECCNT+1
670 FIELD 2, 128 AS OUTREC$
680 LSET OUTREC$=INREC$
690 PUT #2,RECCNT
700 NEXT L!
710 RETURN
720 REM ----------------------------------------------------------------------
730 REM | Subroutine to List Directory Contents                              |
740 REM ----------------------------------------------------------------------
750 PRINT "Directory Contents for Library File: ";ARCHNAME$+".LBR"
760 PRINT:PRINT   " File  Name  Start # Sec Bytes --Date-- --Time--"
780 PRINT         "------------ ----- ----- ----- -------- --------"
790 HILAST=0:'Highest sector in use.
800 NUMDIR=0:'Number of valid directory entries.
810 GET #1:' Skip over directory entry itself.
814 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
816 TOTDIR=(CVI(LAST$)*4)-1
820 GET #1
830 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
840 IF DONE$=CHR$(255) THEN GOTO 930:'Exit if complete
845 NUMDIR=NUMDIR+1
850 IF DONE$=CHR$(254) THEN GOTO 820:'Skip deleted files.
860 IF HILAST<CVI(START$) THEN HILAST=CVI(START$):LASTSEC=CVI(LAST$):'Save highest sector in use.
880 PRINT PRINAME$;" ";SECNAME$;
890 PRINT USING " #####";CVI(START$);CVI(LAST$);128*CVI(LAST$);:PRINT " ";FILEDATE$;" ";FILETIME$
910 GOTO 820
930 RETURN
940 REM ----------------------------------------------------------------------
941 REM | Subroutine to Copy file out of library (From #2 to #3)             |
942 REM ----------------------------------------------------------------------
943 FOR I=1+CVI(START$) TO 1+CVI(START$)+CVI(LAST$)-1
944 GET #2,I
946 FIELD 2, 128 AS INREC$
947 FIELD 3, 128 AS OUTREC$
948 LSET OUTREC$=INREC$
949 PUT #3
950 NEXT I
951 RETURN
952 REM ----------------------------------------------------------------------
953 REM | Subroutine to list a file in a library                             |
954 REM ----------------------------------------------------------------------
955 FOR I=1+CVI(START$) TO (CVI(START$)+CVI(LAST$))
956 GET #2,I
957 FIELD 2, 128 AS INREC$
958 PRINT INREC$;
959 NEXT I
960 RETURN
980 GOTO 980
990 LOCATE ,((78-LEN(H1$))/2):PRINT H1$;:RETURN
995 LOCATE 25,40:PRINT "ERROR - Option Not Implemented Yet!";:BEEP:GOTO 410
1000 REM -----------------------------------------------------------------------
1020 REM | Program Name: LUBLD -- A BASIC Library Builder                      |
1070 REM | Purpose:                                                            |
1080 REM |  To create an library from several individual input files.          |
1090 REM |  This program is based on the library format by G. Novosielski.     |
1100 REM | Comments:                                                           |
1110 REM |  Input is an uncompressed library filename (without any extension). |
1120 REM |  This program creates an library with the user specified name.      |
1130 REM |  Filenames created are of the form:                                 |
1140 REM |             <filename>.lbr                                          |
1150 REM |  which contains a directory portion and a data portion.             |
1160 REM |                                                                     |
1170 REM |  The directory contains a 32 byte record for each file in the       |
1180 REM |  library. The format of this record is as follows:                  |
1190 REM |  Offset Length Description                                          |
1200 REM |    0      1    Flag Byte - as follows:                              |
1210 REM |                00 - Indicates an active directory entry.            |
1220 REM |                FE - Indicates a deleted entry.                      |
1230 REM |                FF - Indicates an unused entry.                      |
1240 REM |    1      8    Primary file name - must be upper case. Left         |
1250 REM |                justified with blanks.                               |
1260 REM |    9      3    File extension - must be upper case. Left just.      |
1270 REM |   12      2    Starting record number in <filename>.LBR for this    |
1280 REM |                file. (Records are 128 bytes long)                   |
1290 REM |   14      2    Number of sectors in file.                           |
1300 REM |   16      8    Member creation date.                                |
1305 REM |   24      8    Member creation time.                                |
1310 REM |  The library file itself consists of 128 byte records. If a file    |
1320 REM |  is not an even multiple of 128 bytes in length, the final record   |
1330 REM |  is padded to make the file an even multiple. The pad character is  |
1340 REM |  chr$(00).                                                          |
1350 REM | Requires:                                                           |
1360 REM |  This program is written in IBM Personal Computer Disk BASIC.       |
1370 REM |  This program operates only in 80 character wide text mode. It      |
1380 REM |  assumes the screen is in that mode at entry.                       |
1390 REM -----------------------------------------------------------------------
1400 CLS
1410 GOSUB 500 ' Get Filename from User.
1420 IF ARCHNAME$="" THEN GOSUB 6100:RUN
1450 ON ERROR GOTO 2180:'Test for file available.
1460 OPEN ARCHFIL$ FOR INPUT AS #1:CLOSE #1
1470 PRINT:PRINT "File "+ARCHFIL$+" already exists. Re-write this file? <N/Y>";:INPUT I$
1480 IF I$="Y" OR I$="y" THEN GOTO 1490 ELSE GOTO 1410
1490 ON ERROR GOTO 0:'Delete file not available error routine.
1500 PRINT:INPUT "Enter maximum number of entries library is to contain:";NUMENT
1510 NUMENT=NUMENT+1:NUMDIR=NUMENT\4
1520 IF NUMENT MOD 4>0 THEN NUMDIR=NUMDIR+1
1530 CLS:PRINT "LUBLD    -    ";TITLE$
1540 PRINT:PRINT"Formatting library directory...";
1550 OPEN ARCHFIL$ AS #1 LEN=32
1560 FOR I=1 TO NUMENT*4
1570 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
1580 LSET DONE$=CHR$(255):LSET PRINAME$=STRING$(8,0):LSET SECNAME$=STRING$(3,0)
1590 LSET START$=MKI$(0):LSET LAST$=MKI$(0)
1595 WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
1600 PUT #1
1610 NEXT I
1620 LSET DONE$=CHR$(0):LSET PRINAME$="********":LSET SECNAME$="DIR":LSET START$=MKI$(0):LSET LAST$=MKI$(NUMDIR):PUT #1,1
1630 CLOSE #1
1640 PRINT"Format complete."
1650 OPEN ARCHFIL$ AS #2 LEN=128
1660 PRINT:PRINT "Enter filenames to be added to library ";ARCHNAME$;". Enter null line to terminate."
1670 NUMFILES=0
1680 ON ERROR GOTO 2190
1690 NUMFILES=NUMFILES+1:PRINT "Filename #";NUMFILES;" <drv:filename.ext> :";:INPUT I$(NUMFILES)
1700 IF LEN(I$(NUMFILES))=0 THEN NUMFILES=NUMFILES-1:GOTO 1800
1710 FOR I=1 TO LEN(I$(NUMFILES))
1720 IF ASC(MID$(I$(NUMFILES),I))>96 THEN MID$(I$(NUMFILES),I)=CHR$(ASC(MID$(I$(NUMFILES),I))-32)
1730 NEXT I
1740 FOR J=1 TO NUMFILES-1
1750 IF I$(NUMFILES)=I$(J) THEN PRINT "ERROR - Same file specified twice.":NUMFILES=NUMFILES-1:GOTO 1690
1760 NEXT J
1770 OPEN I$(NUMFILES) FOR INPUT AS #3:CLOSE #3
1780 IF NUMFILES=NUMENT THEN GOTO 1800
1790 GOTO 1690
1800 ON ERROR GOTO 0
1810 IF NUMFILES<1 THEN PRINT "ERROR - No files specified.":GOTO 1660
1820 PRINT:PRINT NUMFILES;" files to be included in Library ";ARCHNAME$
1830 RECCNT=NUMDIR
1840 FOR I=1 TO NUMFILES
1850 INCNT=0
1860 OPEN I$(I) AS #3 LEN=128
1870 PRINT:PRINT "Copying file #";I;": ";I$(I);" (";LOF(3);"bytes ) --> Library: ";ARCHFIL$
1880 STARTCNT=RECCNT
1890 GOSUB 600 ' Go copy the file into the library.
1970 CLOSE #3
1980 CLOSE #2
1990 OPEN ARCHFIL$ AS #1 LEN=32
2000 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
2010 LSET PRINAME$="":LSET SECNAME$=""
2020 LSET START$=MKI$(STARTCNT)
2030 LSET LAST$=MKI$(RECCNT-STARTCNT)
2040 LSET DONE$=CHR$(0)
2045 WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
2050 IF INSTR(I$(I),":")=2 THEN PRI$=MID$(I$(I),3) ELSE PRI$=I$(I)
2060 IF INSTR(PRI$,".")<>0 THEN SEC$=MID$(PRI$,INSTR(PRI$,".")+1):PRI$=MID$(PRI$,1,INSTR(PRI$,".")-1)
2070 LSET PRINAME$=PRI$+SPACE$(8-LEN(PRI$))
2080 LSET SECNAME$=SEC$+SPACE$(3-LEN(SEC$))
2090 PUT #1,I+1
2100 LSET DONE$=CHR$(255)
2110 PUT #1
2120 CLOSE #1
2130 OPEN ARCHFIL$ AS #2 LEN=128
2140 NEXT I
2150 CLOSE
2160 PRINT:PRINT "Library build completed - directory updated."
2170 GOSUB 6100:RUN
2180 IF ERR=53 THEN RESUME 1490 ELSE ON ERROR GOTO 0
2190 IF ERR=53 THEN PRINT:PRINT "File: ";I$(NUMFILES);" cannot be opened. Please re-specify.":NUMFILES=NUMFILES-1:RESUME 1690 ELSE ON ERROR GOTO 0
3000 REM ----------------------------------------------------------------------
3020 REM | Program Name: LUGET -- A BASIC Library File Retriever              |
3070 REM | Purpose:                                                           |
3080 REM |  To copy a file from an library to a separate file.                |
3090 REM |  This program is based upon the LU library format by G. Novosielski|
3100 REM | Comments:                                                          |
3110 REM |  Input is an uncompressed library filename (without any extension).|
3120 REM |  This program reads and lists the contents of the library          |
3130 REM |  directory. It then prompts the user for the name of the file to   |
3140 REM |  be retrieved. Filename is of the form:                            |
3150 REM |             <filename>.lbr                                         |
3160 REM | Requires:                                                          |
3170 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
3180 REM |  This program operates only in 80 character wide text mode. It     |
3190 REM |  assumes the screen is in that mode at entry.                      |
3200 REM ----------------------------------------------------------------------
3210 CLS
3220 GOSUB 500
3230 IF ARCHNAME$="" THEN GOSUB 6100:RUN
3270 ON ERROR GOTO 3880:'Test for file available.
3280 OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
3290 OPEN ARCHFIL$ FOR INPUT AS #2:CLOSE #2
3300 ON ERROR GOTO 0:'Delete file not available error routine.
3310 OPEN ARCHDIR$ AS #1 LEN=32
3320 CLS:IF VAL(I$)=4 THEN PRINT "LUGET    -    ";TITLE$
3325 IF VAL(I$)=5 THEN PRINT "LUTYPE   -    ";TITLE$
3330 GOSUB 720
3510 PRINT:IF VAL(I$)=4 THEN INPUT "Enter file name to be retrieved :";GETFIL$
3515 IF VAL(I$)=5 THEN INPUT "Enter file name to be listed :";GETFIL$
3520 IF GETFIL$="" THEN GOSUB 6100:RUN
3530 IF LEN(GETFIL$)>12 THEN PRINT "ERROR - Filename is too long.":GOTO 3510
3540 FOR I=1 TO LEN(GETFIL$):'Translate to upper case.
3550 IF ASC(MID$(GETFIL$,I))>96 THEN MID$(GETFIL$,I)=CHR$(ASC(MID$(GETFIL$,I))-32)
3560 NEXT I
3570 IF INSTR(GETFIL$,".")<>0 THEN GETPRI$=LEFT$(GETFIL$,INSTR(GETFIL$,".")-1):GETSEC$=MID$(GETFIL$,INSTR(GETFIL$,".")+1)
3580 FOR I=2 TO NUMDIR+1
3590 GET #1,I
3600 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
3605 IF DONE$=CHR$(254) THEN GOTO 3620
3610 IF GETPRI$+STRING$(8-LEN(GETPRI$)," ")=PRINAME$ THEN IF GETSEC$+STRING$(3-LEN(GETSEC$)," ")=SECNAME$ THEN GOTO 3640
3620 NEXT I
3630 PRINT:PRINT "ERROR - File not found.":GOTO 3510
3640 OPEN ARCHFIL$ AS #2 LEN=128
3650 OUTFIL$=""
3660 IF INSTR(ARCHNAME$,":")=2 THEN OUTFIL$=LEFT$(ARCHNAME$,2)
3670 OUTFIL$=OUTFIL$+GETPRI$+"."+GETSEC$
3675 IF VAL(I$)=5 THEN GOTO 3780
3680 PRINT:PRINT "Re-specify filename or hit enter to use:";OUTFIL$;:INPUT Q$
3690 IF Q$="" THEN GOTO 3700 ELSE OUTFIL$=Q$
3700 ON ERROR GOTO 3900
3710 OPEN OUTFIL$ FOR INPUT AS #3
3720 PRINT:PRINT "WARNING - File ";OUTFIL$;" already exists. Re-write existing file? <N/Y>";:INPUT Q$
3730 IF Q$="Y" OR Q$="y" THEN GOTO 3740 ELSE PRINT "LUGET - Execution terminated.":CLOSE #3:GOSUB 6100:RUN
3740 CLOSE #3
3750 ON ERROR GOTO 0
3760 OPEN OUTFIL$ AS #3 LEN=128
3770 PRINT:PRINT"Copying file ";GETPRI$+"."+GETSEC$;" from library ";ARCHFIL$;" (";128*CVI(LAST$);" bytes) to file ";OUTFIL$;"."
3780 IF VAL(I$)=4 THEN GOSUB 940
3785 IF VAL(I$)=5 THEN CLS:GOSUB 952
3850 CLOSE
3860 PRINT:IF VAL(I$)=4 THEN PRINT "LUGET - Copy completed." ELSE PRINT:PRINT "LUTYPE - Listing Completed."
3870 GOSUB 6100:RUN
3880 IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 3220
3890 ON ERROR GOTO 0
3900 IF ERR=53 THEN RESUME 3760
3910 IF ERR=64 THEN PRINT"ERROR - Invalid filename specified.":RESUME 3650
3920 ON ERROR GOTO 0
4000 REM ----------------------------------------------------------------------
4020 REM | Program Name: LUDIR -- A BASIC Library Directory Lister            |
4070 REM | Purpose:                                                           |
4080 REM |  To list the contents of an library directory.                     |
4090 REM |  Uses the library format devised by Gary Novosielski for CP/M.     |
4100 REM | Comments:                                                          |
4110 REM |  Input is an uncompressed library filename (without any extension).|
4120 REM |  This program reads and lists the contents of the library          |
4130 REM |  directory. Filename  is  assumed to be of the form:               |
4140 REM |             <filename>.lbr                                         |
4150 REM | Requires:                                                          |
4160 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
4170 REM |  This program operates only in 80 character wide text mode. It     |
4180 REM |  assumes the screen is in that mode at entry.                      |
4190 REM ----------------------------------------------------------------------
4200 CLS
4210 GOSUB 500
4220 IF ARCHNAME$="" THEN GOSUB 6100:RUN
4250 ON ERROR GOTO 4440:'Test for file available.
4260 OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
4270 ON ERROR GOTO 0:'Delete file not available error routine.
4280 OPEN ARCHDIR$ AS #1 LEN=32
4290 CLS:PRINT "LUDIR    -    ";TITLE$
4300 GOSUB 720
4310 GOSUB 6100:RUN
4440 IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 4210
4450 IF ERR=64 THEN PRINT "ERROR - Bad filename specified.":RESUME 4210
4460 ON ERROR GOTO 0
5000 REM ----------------------------------------------------------------------
5020 REM | Program Name: LUSPR -- A  Library Expander                         |
5070 REM | Purpose:                                                           |
5080 REM |  To completely unload a  library to individual files.              |
5090 REM | Comments:                                                          |
5100 REM |  Input is an uncompressed library filename (without any extension).|
5110 REM |  This program reads the directory and creates new files from the   |
5120 REM |  directory / source file. Filenames are assumed to be of the form: |
5130 REM |             <filename>.lbr                                         |
5140 REM |  Output files will be created based upon the contents of the dir-  |
5150 REM |  ectory.       These new files will be allocated on the same drive |
5160 REM |  that contains the library itself. Library files are assumed to    |
5170 REM |  be in the format originated by Gary Novosielski   for CP/M systems|
5180 REM |  and widely used on Remote CP/M systems.                           |
5190 REM | Requires:                                                          |
5200 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
5210 REM |  This program assumes an 80 character text display is active when  |
5220 REM |  is begins execution.                                              |
5230 REM ----------------------------------------------------------------------
5240 CLS
5250 GOSUB 500
5280 ON ERROR GOTO 5580:'Test for file available.
5290 OPEN ARCHFIL$ FOR INPUT AS #1:CLOSE #1
5300 ON ERROR GOTO 0:'Delete file not available error routine.
5310 IF INSTR(ARCHNAME$,":")=2 THEN OUTNAME$=LEFT$(ARCHNAME$,2)
5320 OPEN ARCHDIR$ AS #1 LEN=32
5330 OPEN ARCHFIL$ AS #2 LEN=128
5340 GET #1:'Skip directory itself.
5350 GET #1
5360 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
5370 IF DONE$=CHR$(255) THEN GOSUB 6100:RUN:'Exit if complete
5380 IF DONE$=CHR$(254) THEN GOTO 5350:'Skip deleted entries
5390 IF INSTR(PRINAME$," ")>0 THEN O$=LEFT$(PRINAME$,(INSTR(PRINAME$," ")-1))+"."+SECNAME$ ELSE O$=PRINAME$+"."+SECNAME$
5400 OUTNAME$=OUTNAME$+O$
5410 PRINT:PRINT "Copying member ";O$;".":PRINT"   Re-specify filename or hit enter to use:";OUTNAME$;".";:INPUT I$
5420 IF I$="" THEN GOTO 5430 ELSE OUTNAME$=I$
5430 PRINT "   Opening file: ";OUTNAME$;" to copy ";128*CVI(LAST$);" bytes."
5440 OPEN OUTNAME$ AS #3 LEN=128
5450 ON ERROR GOTO 5600
5460 GOSUB 940
5530 ON ERROR GOTO 0
5540 PRINT "Copy completed for file: ";OUTNAME$
5550 CLOSE #3
5560 IF INSTR(ARCHNAME$,":")=2 THEN OUTNAME$=LEFT$(ARCHNAME$,2) ELSE OUTNAME$=""
5570 GOTO 5350
5580 IF ERR=53 THEN PRINT "File not found.":RESUME 5250
5590 ON ERROR GOTO 0
5600 'Error routine for input.
5610 IF ERR=50 AND ERL=5470 THEN ON ERROR GOTO 0:PUT #3:CLOSE #3:RESUME 5350
5620 ON ERROR GOTO 0
6000 CLS:SYSTEM
6100 LOCATE 25,1:PRINT"Hit ENTER to continue:";:LINE INPUT I$:RETURN
7000 REM ----------------------------------------------------------------------
7010 REM | Program Name: LUDEL -- A BASIC Library File Delete Routine         |
7020 REM | Purpose:                                                           |
7030 REM |  To delete a file currently in a library.                          |
7040 REM |  This program is based upon the LU library format by G. Novosielski|
7050 REM | Comments:                                                          |
7060 REM |  Input is an uncompressed library filename (without any extension).|
7070 REM |  This program deletes a file by changing the first byte to a       |
7080 REM |  hex FE. All other entries in the directory for this file are left |
7090 REM |  unchanged.                                                        |
7100 REM | Requires:                                                          |
7110 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
7120 REM |  This program operates only in 80 character wide text mode. It     |
7130 REM |  assumes the screen is in that mode at entry.                      |
7140 REM ----------------------------------------------------------------------
7150 CLS
7160 GOSUB 500
7170 IF ARCHNAME$="" THEN GOSUB 6100:RUN
7180 ON ERROR GOTO 7610:'Test for file available.
7190 OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
7210 ON ERROR GOTO 0:'Delete file not available error routine.
7220 OPEN ARCHDIR$ AS #1 LEN=32
7230 CLS:PRINT "LUDEL    -    ";TITLE$
7240 GOSUB 720
7260 PRINT:INPUT "Enter file name to be deleted :";GETFIL$
7280 IF GETFIL$="" THEN GOSUB 6100:RUN
7290 IF LEN(GETFIL$)>12 THEN PRINT "ERROR - Filename is too long.":GOTO 7260
7300 FOR I=1 TO LEN(GETFIL$):'Translate to upper case.
7310 IF ASC(MID$(GETFIL$,I))>96 THEN MID$(GETFIL$,I)=CHR$(ASC(MID$(GETFIL$,I))-32)
7320 NEXT I
7330 IF INSTR(GETFIL$,".")<>0 THEN GETPRI$=LEFT$(GETFIL$,INSTR(GETFIL$,".")-1):GETSEC$=MID$(GETFIL$,INSTR(GETFIL$,".")+1)
7340 FOR I=2 TO NUMDIR+1
7350 GET #1,I
7360 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
7370 IF DONE$=CHR$(254) THEN GOTO 7390
7380 IF GETPRI$+STRING$(8-LEN(GETPRI$)," ")=PRINAME$ THEN IF GETSEC$+STRING$(3-LEN(GETSEC$)," ")=SECNAME$ THEN GOTO 7410
7390 NEXT I
7400 PRINT:PRINT "ERROR - File not found.":GOTO 7260
7410 LSET DONE$=CHR$(254)
7420 PUT #1,I
7580 CLOSE
7590 PRINT:PRINT "LUDEL - Member deleted."
7600 GOSUB 6100:RUN
7610 IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 7160
7620 ON ERROR GOTO 0
7630 IF ERR=53 THEN RESUME 7540
7640 IF ERR=64 THEN PRINT"ERROR - Invalid filename specified.":RESUME 7420
7650 ON ERROR GOTO 0
7660 REM ----------------------------------------------------------------------
8000 REM -----------------------------------------------------------------------
8010 REM | Program Name: LUADD -- A BASIC Library Add File Routine             |
8020 REM | Purpose:                                                            |
8030 REM |  To add a new member to an existing library.                        |
8040 REM | Requires:                                                           |
8050 REM |  This program is written in IBM Personal Computer Disk BASIC.       |
8060 REM |  This program operates only in 80 character wide text mode. It      |
8070 REM |  assumes the screen is in that mode at entry.                       |
8080 REM -----------------------------------------------------------------------
8090 CLS
8100 GOSUB 500 ' Get Filename from User.
8110 IF ARCHNAME$="" THEN GOSUB 6100:RUN
8120 ON ERROR GOTO 8600:'Test for file available.
8125 OPEN ARCHDIR$ AS #1 LEN=32
8130 OPEN ARCHFIL$ AS #2 LEN=128
8135 GOSUB 720:' Go list directory for this file - and get highest sector in use in variable HILAST.
8137 PRINT:PRINT TOTDIR-NUMDIR;" files may be added to library ";ARCHNAME$
8138 IF TOTDIR-NUMDIR<1 THEN PRINT "No files can be added to this library.":GOSUB 6100:RUN
8140 PRINT:PRINT "Enter filenames to be added to library ";ARCHNAME$;". Enter null line to terminate."
8150 NUMFILES=0
8160 ON ERROR GOTO 8610
8170 NUMFILES=NUMFILES+1:PRINT "Filename #";NUMFILES;" <drv:filename.ext> :";:INPUT I$(NUMFILES)
8180 IF LEN(I$(NUMFILES))=0 THEN NUMFILES=NUMFILES-1:GOTO 8280
8190 FOR I=1 TO LEN(I$(NUMFILES))
8200 IF ASC(MID$(I$(NUMFILES),I))>96 THEN MID$(I$(NUMFILES),I)=CHR$(ASC(MID$(I$(NUMFILES),I))-32)
8210 NEXT I
8220 FOR J=1 TO NUMFILES-1
8230 IF I$(NUMFILES)=I$(J) THEN PRINT "ERROR - Same file specified twice.":NUMFILES=NUMFILES-1:GOTO 8170
8240 NEXT J
8250 OPEN I$(NUMFILES) FOR INPUT AS #3:CLOSE #3
8260 IF NUMFILES=TOTDIR-NUMDIR THEN GOTO 8280
8270 GOTO 8170
8280 ON ERROR GOTO 0
8290 IF NUMFILES<1 THEN PRINT "ERROR - No files specified.":GOTO 8140
8300 PRINT:PRINT NUMFILES;" files to be added to Library ";ARCHNAME$
8310 RECCNT=HILAST+LASTSEC:'Add new files to end of library.
8320 FOR I=1 TO NUMFILES
8330 INCNT=0
8340 OPEN I$(I) AS #3 LEN=128
8350 PRINT:PRINT "Copying file #";I;": ";I$(I);" (";LOF(3);"bytes ) --> Library: ";ARCHFIL$
8360 STARTCNT=RECCNT
8370 GOSUB 600 ' Go copy the file into the library.
8380 CLOSE #3
8390 CLOSE #2
8410 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
8420 LSET PRINAME$="":LSET SECNAME$=""
8430 LSET START$=MKI$(STARTCNT)
8440 LSET LAST$=MKI$(RECCNT-STARTCNT)
8450 LSET DONE$=CHR$(0)
8460 WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
8470 IF INSTR(I$(I),":")=2 THEN PRI$=MID$(I$(I),3) ELSE PRI$=I$(I)
8480 IF INSTR(PRI$,".")<>0 THEN SEC$=MID$(PRI$,INSTR(PRI$,".")+1):PRI$=MID$(PRI$,1,INSTR(PRI$,".")-1)
8490 LSET PRINAME$=PRI$+SPACE$(8-LEN(PRI$))
8500 LSET SECNAME$=SEC$+SPACE$(3-LEN(SEC$))
8510 PUT #1,NUMDIR+I+1
8520 LSET DONE$=CHR$(255)
8530 PUT #1
8550 OPEN ARCHFIL$ AS #2 LEN=128
8560 NEXT I
8570 CLOSE
8580 PRINT:PRINT "LUADD completed - directory updated."
8590 GOSUB 6100:RUN
8600 IF ERR=53 THEN RESUME 1490 ELSE ON ERROR GOTO 0
8610 IF ERR=53
D completed - directory